使用VBA代码,自定义页面数拆分大Word文件为多个小文档并指定名称保存
alt+F11打开开发选项-->选择【插入】-->【模块】-->弹出代码编辑窗口,插入下面代码,按照需要修改页数和要重命名的每个文档按顺序的名字--->按F5运行代码,文档最后就生成在当前目录下了
在word的某些版本上可能出现格式不对,最后测试在最新的wps上跑效果最好
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub SplitEveryFivePagesAsDocuments()
On Error GoTo Errorhandler
Dim oSrcDoc As Document, oNewDoc As Document
Dim nameArray As Variant
Dim strSrcName As String, strNewName As String
Dim oRange As Range
Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer
Dim fso As Object
Const nSteps = 4 '设置多少页分割一次
nameArray = Array("Cat", "Dog", "Rabbit") '数组内容修改为需要的命名
Set fso = CreateObject("Scripting.FileSystemObject")
Set oSrcDoc = ActiveDocument
Set oRange = oSrcDoc.Content
nTotalPages =Val(ActiveDocument.BuiltInDocumentProperties(wdPropertyPages))
oRange.Collapse wdCollapseStart
oRange.Select
For nIndex = 1 To nTotalPages Step nSteps
If nIndex + nSteps > nTotalPages Then
nBound = nTotalPages
Else
nBound = nIndex + nSteps - 1
End If
Set oNewDoc = Documents.Add
For nSubIndex = nIndex To nBound
oSrcDoc.Activate
oSrcDoc.Bookmarks("\page").Range.Copy
oSrcDoc.Windows(1).Activate
Application.Browser.Target = wdBrowsePage
Application.Browser.Next
Sleep 10
oNewDoc.Activate
oNewDoc.Windows(1).Selection.Paste
Errorhandler:
If Err = 4605 Then
oNewDoc.Windows(1).Selection.Paste
Else
Resume Next
End If
MsgBox "nSubIndex" & "_" & nSubIndex
Next nSubIndex
strSrcName = oSrcDoc.FullName
strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
fso.GetBaseName(strSrcName) & "_" & nameArray(nIndex\nSteps) & "." & fso.GetExtensionName(strSrcName))
oNewDoc.SaveAs strNewName
oNewDoc.Close False
MsgBox nameArray(nIndex\nSteps)
Next nIndex
Set oNewDoc = Nothing
Set oRange = Nothing
Set oSrcDoc = Nothing
Set fso = Nothing
MsgBox "结束!"
End Sub